home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / AnimText.pprx < prev    next >
Text File  |  1998-04-27  |  12KB  |  508 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1995-1998 Cloanto Italia srl */
  2.  
  3. /* $VER: AnimText.pprx 1.3 */
  4.  
  5. /** ENG
  6.   This script renders a text string using AnimFonts by Kara Computer
  7.   Graphics. The resulting animation is played or placed in the current
  8.   brush.
  9.  
  10.   One AnimFont is included with the Cloanto Personal Suite CD-ROM,
  11.   while The Kara Collection CD-ROM contains five AnimFonts.
  12. */
  13.  
  14. /** DEU
  15.   Dieses Skript erzeugt unter Verwendung der AnimFonts von Kara
  16.   Computer Graphics (nicht in Personal Paint enthalten) eine Zeichenfolge.
  17.   Die daraus resultierende Animation wird wahlweise abgespielt oder im
  18.   aktuellen Brush abgelegt.
  19.  
  20.   Die CD-ROM "The Kara Collection" enthält fünf AnimFonts. Die CD-ROM
  21.   "Personal Suite" enthält ein AnimFont. 
  22. */
  23.  
  24. /** ITA
  25.   Questo script realizza una stringa di testo utilizzando AnimFonts di Kara
  26.   Computer Graphics. L'animazione risultante viene mostrata oppure è inserita
  27.   nel pennello corrente.
  28.  
  29.   I font animati "AnimFonts" sono compresi nel CD-ROM Cloanto The Kara
  30.   Collection. Il CD-ROM Personal Suite contiene un font animato.
  31. */
  32.  
  33. absh_dir.1 = 'PPaint:AnimBrushes/AnimFonts'
  34. data_dir.1 = 'PPaint:AnimBrushes/AnimFonts'
  35. absh_dir.2 = 'KaraCD:PPaint/AnimBrushes/AnimFonts'
  36. data_dir.2 = 'KaraCD:PPaint/AnimBrushes/AnimFonts'
  37. absh_dir.3 = 'AnimBrushes/AnimFonts'
  38. data_dir.3 = 'AnimBrushes/AnimFonts'
  39. absh_dir.4 = 'PSuite:PPaint/AnimBrushes/AnimFonts'
  40. data_dir.4 = 'PSuite:PPaint/AnimBrushes/AnimFonts'
  41. absh_dir.5 = 'KaraCD:AnimFonts/AnimBrushes'
  42. data_dir.5 = 'KaraCD:AnimFonts/AnimBrushes'
  43. path_num   = 5
  44.  
  45. IF ARG(1, EXISTS) THEN
  46.     PARSE ARG PPPORT
  47. ELSE
  48.     PPPORT = 'PPAINT'
  49.  
  50. IF ~SHOW('P', PPPORT) THEN DO
  51.     IF EXISTS('PPaint:PPaint') THEN DO
  52.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  53.         DO 30 WHILE ~SHOW('P',PPPORT)
  54.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  55.         END
  56.     END
  57.     ELSE DO
  58.         SAY "Personal Paint could not be loaded."
  59.         EXIT 10
  60.     END
  61. END
  62.  
  63. IF ~SHOW('P', PPPORT) THEN DO
  64.     SAY 'Personal Paint Rexx port could not be opened'
  65.     EXIT 10
  66. END
  67.  
  68. ADDRESS VALUE PPPORT
  69. OPTIONS RESULTS
  70. OPTIONS FAILAT 10000
  71.  
  72. Get 'LANG'
  73. IF RESULT = 1 THEN DO        /* Deutsch */
  74.     txt_title_req     = 'AnimText-Einstellungen'
  75.     txt_gad_lst       = 'Anim_Font:'
  76.     txt_gad_str       = '_Text:'
  77.     txt_string_str    = 'Text'
  78.     txt_gad_cyc       = '_Darstellen:'
  79.     txt_gad_cyc0      = 'Von Links nach Rechts'
  80.     txt_gad_cyc1      = 'Gleichzeitig'
  81.     txt_gad_num0      = 'Ab_stand:'
  82.     txt_gad_num1      = 'Einzelbild-_Offset:'
  83.     txt_gad_chk       = 'Anim-_Brush:'
  84.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  85.     txt_err_noafonts  = 'AnimFonts konnten nicht_gefunden werden'
  86.     txt_err_nodfile   = 'Fontdatei konnte nicht_gefunden werden'
  87.     txt_err_noenv     = 'Andere Umgebung_kann nicht erstellt werden'
  88. END
  89. ELSE IF RESULT = 3 THEN DO    /* Français */
  90.     txt_title_req     = "Réglages d'AnimText"
  91.     txt_gad_lst       = 'Anim_Font :'
  92.     txt_gad_str       = '_Texte :'
  93.     txt_string_str    = 'Texte'
  94.     txt_gad_cyc       = 'Apparitio_n :'
  95.     txt_gad_cyc0      = 'De gauche à droite'
  96.     txt_gad_cyc1      = 'Simultanément'
  97.     txt_gad_num0      = 'E_spacement :'
  98.     txt_gad_num1      = '_Retard :'
  99.     txt_gad_chk       = '_Brosse animée :'
  100.     txt_err_oldclient = 'Ce script nécessite une nouvelle_version de Personal Paint'
  101.     txt_err_noafonts  = 'AnimFonts non trouvées'
  102.     txt_err_nodfile   = 'Impossible de trouver_le fichier de données_de la police'
  103.     txt_err_noenv     = "Impossible de créer_l'autre environnement"
  104. END
  105. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  106.     txt_title_req     = 'Parametri AnimText'
  107.     txt_gad_lst       = 'Anim_Font:'
  108.     txt_gad_str       = '_Testo:'
  109.     txt_string_str    = 'Testo'
  110.     txt_gad_cyc       = '_Scrittura:'
  111.     txt_gad_cyc0      = 'Da sinistra a destra'
  112.     txt_gad_cyc1      = 'Simultanea'
  113.     txt_gad_num0      = '_Spaziatura:'
  114.     txt_gad_num1      = 'Sp_ostamento:'
  115.     txt_gad_chk       = 'Anim-_Brush:'
  116.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  117.     txt_err_noafonts  = 'Impossibile trovare AnimFont'
  118.     txt_err_nodfile   = 'Impossibile aprire_il file dati'
  119.     txt_err_noenv     = 'Impossibile creare_ambiente alternativo'
  120. END
  121. ELSE DO                /* English */
  122.     txt_title_req     = 'AnimText Settings'
  123.     txt_gad_lst       = 'Anim_Font:'
  124.     txt_gad_str       = '_Text:'
  125.     txt_string_str    = 'Text'
  126.     txt_gad_cyc       = '_Render:'
  127.     txt_gad_cyc0      = 'Left to right'
  128.     txt_gad_cyc1      = 'Simultaneously'
  129.     txt_gad_num0      = '_Spacing:'
  130.     txt_gad_num1      = 'F_rame Offset:'
  131.     txt_gad_chk       = 'Anim-_Brush:'
  132.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  133.     txt_err_noafonts  = 'AnimFonts not found'
  134.     txt_err_nodfile   = 'Font data file_cannot be found'
  135.     txt_err_noenv     = 'Other environment_cannot be created'
  136. END
  137.  
  138. Version 'REXX'
  139. IF RESULT < 7 THEN DO
  140.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  141.     EXIT 10
  142. END
  143.  
  144. FreeBrush
  145. IF RC ~= 0 THEN
  146.     EXIT RC
  147.  
  148. /* Build the list of available AnimFonts */
  149.  
  150. tmpfname = 'T:pprx_temp.'PRAGMA('ID')
  151. ftot = 0
  152. CALL PRAGMA('Window', 'Null')
  153.  
  154. DO pnum = 1 to path_num
  155.     sv_cd = PRAGMA('D')
  156.     IF PRAGMA('D', absh_dir.pnum) = sv_cd THEN DO
  157.         CALL PRAGMA('D', sv_cd)
  158.         ADDRESS COMMAND 'List >'tmpfname' 'absh_dir.pnum' NOHEAD LFORMAT="%s" DIRS'
  159.         IF RC = 0 THEN DO
  160.             ADDRESS COMMAND 'Sort 'tmpfname tmpfname'.s'
  161.             IF RC = 0 THEN DO
  162.                 ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  163.                 tmpfname = tmpfname'.s'
  164.             END
  165.             IF OPEN('listfile', tmpfname, 'R') THEN DO
  166.                 DO FOREVER
  167.                     fline = READLN('listfile')
  168.                     IF EOF('listfile') THEN BREAK
  169.                     ftot = ftot + 1
  170.                     fontname.ftot = fline
  171.                 END
  172.                 CALL CLOSE('listfile')
  173.             END
  174.         END
  175.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  176.         IF ftot ~= 0 THEN
  177.             LEAVE
  178.     END
  179. END
  180. CALL PRAGMA('Window', 'Workbench')
  181.  
  182. IF ftot = 0 THEN DO
  183.     RequestNotify 'PROMPT "'txt_err_noafonts'"'
  184.     EXIT 10
  185. END
  186.  
  187.  
  188. /* Build and show the settings requester */
  189.  
  190. font = LoadSet('Font', 0)
  191. txt_string_str = LoadSet('Text', txt_string_str)
  192. render  = LoadSet('Render', 0)
  193. spacing = LoadSet('Spacing', 0)
  194. offset  = LoadSet('Offset', 0)
  195. getbsh  = LoadSet('Getbsh', 1)
  196.  
  197. req = '"LIST = ""'txt_gad_lst'"", 'ftot', 'font', 20, 5'  /* max 5 rows to fit into a 320x200 screen */
  198. DO f = 1 TO ftot
  199.     req = req || ', ""' || fontname.f || '""'
  200. END
  201.  
  202. req = req ||,
  203.     ' STRING = ""'txt_gad_str'"", 256, ""'txt_string_str'"" ' ||,
  204.     'CYCLE = ""'txt_gad_cyc'"", 2, 'render', ""'txt_gad_cyc0'"", ""'txt_gad_cyc1'"" ' ||,
  205.     'INTSTR = ""'txt_gad_num0'"", -32768, 32767, 'spacing' ' ||,
  206.     'INTSTR = ""'txt_gad_num1'"", -32768, 32767, 'offset' ' ||,
  207.     'CHECK = ""'txt_gad_chk'"", 'getbsh' "'
  208.  
  209. Request 'RESIZE "'txt_title_req'"' req
  210. IF RC = 0 THEN DO
  211.     font    = RESULT.1
  212.     text    = RESULT.2
  213.     render  = RESULT.3
  214.     spacing = RESULT.4
  215.     offset  = RESULT.5
  216.     getbsh  = RESULT.6
  217.  
  218.     CALL SaveSet('Font', font)        /* setting persistence */
  219.     CALL SaveSet('Text', text)
  220.     CALL SaveSet('Render', render)
  221.     CALL SaveSet('Spacing', spacing)
  222.     CALL SaveSet('Offset', offset)
  223.     CALL SaveSet('Getbsh', getbsh)
  224. END
  225. ELSE EXIT 0
  226.  
  227. font = font + 1
  228. abshpath = absh_dir.pnum'/'fontname.font'/'
  229. dataname = data_dir.pnum'/'fontname.font'.data'
  230.  
  231. len = LENGTH(text)
  232. fontdata. = 'undef'
  233.  
  234.  
  235.  
  236. /* Read data file */
  237.  
  238. IF OPEN('datafile', dataname, 'R') THEN DO
  239.     READLN('datafile')
  240.     skip_first = READLN('datafile')
  241.     frm_offset = READLN('datafile')
  242.     DO FOREVER
  243.         fline = READLN('datafile')
  244.         IF EOF('datafile') THEN BREAK
  245.         PARSE VAR fline chr nm spc hdx
  246.         fontdata.name.chr  = nm
  247.         fontdata.space.chr = spc
  248.         fontdata.handx.chr = hdx
  249.     END
  250.     CALL CLOSE('datafile')
  251. END
  252. ELSE DO
  253.     RequestNotify 'PROMPT "'txt_err_nodfile'"'
  254.     EXIT 10
  255. END
  256.  
  257.  
  258.  
  259. /* Render the text */
  260.  
  261. LockGUI
  262.  
  263. Get 'IMAGEW'
  264. img_width = RESULT
  265. Get 'DISPLAY'
  266. img_disp = RESULT
  267.  
  268. SwitchEnvironment
  269. FreeEnvironment 'QUERY'
  270. IF RC ~= 0 THEN DO
  271.     UnlockGUI
  272.     EXIT RC
  273. END
  274.  
  275. Get 'GCLIP'
  276. saveclip = RESULT
  277. Set '"GCLIP=0"'
  278.  
  279. DeleteFrames 'ALL FORCE'
  280. ClearImage
  281. SetPaintMode 'MATTE'
  282. xmax = 0
  283. ymax = 0
  284. error = 0
  285. IF render = 0 THEN DO    /* Left to right */
  286.     xpos = 0
  287.     ypos = 0
  288.     first = 1
  289.     DO c = 1 TO len
  290.         chr = UseChar(SUBSTR(text, c, 1))
  291.         IF chr = 32 | chr = 60 | chr = 62 THEN DO
  292.             IF fontdata.space.chr ~= 'undef' THEN
  293.                 xpos = xpos + fontdata.space.chr + spacing
  294.         END
  295.         ELSE DO
  296.             LoadAnimBrush '"'abshpath || fontdata.name.chr'"' FORCE QUIET NOPROGRESS
  297.             IF RC = 0 THEN DO
  298.                 GetBrushAttributes 'FRAMES'
  299.                 frm = RESULT
  300.                 IF skip_first THEN
  301.                     frm = frm - 1
  302.  
  303.                 IF first THEN DO
  304.                     first = 0
  305.                     error = SetupEnv(img_width, img_disp)
  306.                     IF error ~= 0 THEN
  307.                         LEAVE c
  308.                     UseBrushPalette
  309.                     IF fontdata.handx.chr > 0 THEN
  310.                         xpos = fontdata.handx.chr
  311.  
  312.                     AddFrames frm
  313.                 END
  314.                 ELSE DO
  315.                     GetFrames
  316.                     tot = RESULT
  317.                     pos = tot + frm_offset + offset
  318.                     add = frm - (tot - pos)
  319.                     IF add > 0 THEN
  320.                         AddFrames add 'AFTER' tot
  321.                     SetFramePosition pos + 1
  322.                 END
  323.  
  324.                 SetBrushAttributes 'FRAMEPOSITION 2 HANDLEX' fontdata.handx.chr 'HANDLEY 0'
  325.                 DO f = 1 TO frm
  326.                     PutBrush xpos ypos
  327.                     SetFramePosition 'NEXT'
  328.                 END
  329.  
  330.                 GetBrushAttributes 'WIDTH'
  331.                 x1 = xpos - fontdata.handx.chr + RESULT - 1
  332.                 IF x1 > xmax THEN
  333.                     xmax = x1
  334.                 GetBrushAttributes 'HEIGHT'
  335.                 y1 = ypos + RESULT - 1
  336.                 IF y1 > ymax THEN
  337.                     ymax = y1
  338.                 xpos = xpos + fontdata.space.chr + spacing
  339.             END
  340.         END
  341.     END
  342. END
  343. ELSE DO    /* Simultaneously */
  344.     max_frm = 0
  345.     DO c = 1 TO len
  346.         chr = UseChar(SUBSTR(text, c, 1))
  347.         IF chr ~= 32 & chr ~= 60 & chr ~= 62 THEN DO
  348.             LoadAnimBrush '"'abshpath || fontdata.name.chr'" FORCE QUIET NOPROGRESS'
  349.             IF RC = 0 THEN DO
  350.                 GetBrushAttributes 'FRAMES'
  351.                 frm = RESULT
  352.                 IF frm > max_frm THEN
  353.                     max_frm = frm
  354.             END
  355.         END
  356.     END
  357.     error = SetupEnv(img_width, img_disp)
  358.     IF error = 0 THEN DO
  359.         IF skip_first THEN
  360.             max_frm = max_frm - 1
  361.         UseBrushPalette
  362.         AddFrames max_frm
  363.  
  364.         DO f = 1 TO max_frm
  365.             xpos = 0
  366.             ypos = 0
  367.             first = 1
  368.             DO c = 1 TO len
  369.                 chr = UseChar(SUBSTR(text, c, 1))
  370.                 IF chr = 32 | chr = 60 | chr = 62 THEN DO
  371.                     IF fontdata.space.chr ~= 'undef' THEN
  372.                         xpos = xpos + fontdata.space.chr + spacing
  373.                 END
  374.                 ELSE DO
  375.                     LoadAnimBrush '"'abshpath || fontdata.name.chr'" FORCE QUIET NOPROGRESS'
  376.                     IF RC = 0 THEN DO
  377.                         GetBrushAttributes 'FRAMES'
  378.                         frm = RESULT
  379.  
  380.                         IF first THEN DO
  381.                             first = 0
  382.                             IF fontdata.handx.chr > 0 THEN
  383.                                 xpos = fontdata.handx.chr
  384.                         END
  385.                         fpos = f + 1
  386.                         IF fpos > frm THEN DO
  387.                             IF skip_first THEN
  388.                                 fpos = frm
  389.                             ELSE
  390.                                 fpos = 1
  391.                         END
  392.                         SetBrushAttributes 'FRAMEPOSITION' fpos 'HANDLEX' fontdata.handx.chr 'HANDLEY 0'
  393.                         PutBrush xpos ypos
  394.  
  395.                         IF f = 1 THEN DO
  396.                             GetBrushAttributes 'WIDTH'
  397.                             x1 = xpos - fontdata.handx.chr + RESULT - 1
  398.                             IF x1 > xmax THEN
  399.                                 xmax = x1
  400.                             GetBrushAttributes 'HEIGHT'
  401.                             y1 = ypos + RESULT - 1
  402.                             IF y1 > ymax THEN
  403.                                 ymax = y1
  404.                         END
  405.                         xpos = xpos + fontdata.space.chr + spacing
  406.                     END
  407.                 END
  408.             END
  409.             SetFramePosition 'NEXT'
  410.         END
  411.     END
  412. END
  413.  
  414. IF error = 0 THEN DO
  415.     SetFramePosition 1
  416.     IF getbsh THEN DO
  417.         GetFrames
  418.         frm = RESULT
  419.         DefineBrush 0 0 xmax ymax frm
  420.         IF RC = 0 THEN
  421.             FreeEnvironment 'FORCE'
  422.     END
  423.     ELSE DO
  424.         FreeBrush 'FORCE'
  425.         Play 'FORCE'
  426.     END
  427. END
  428. ELSE
  429.     RequestNotify 'PROMPT "'txt_err_noenv'"'
  430.  
  431. Set '"GCLIP='saveclip'"'
  432. UnlockGUI
  433. EXIT 0
  434.  
  435.  
  436.  
  437.  
  438. UseChar:
  439.     ch = ARG(1)
  440.  
  441.     code = C2D(ch)
  442.  
  443.     IF fontdata.space.code = 'undef' THEN DO
  444.         IF ch >= 'A' & ch <= 'Z' THEN
  445.             code = code + 32
  446.         ELSE IF ch >= 'a' & ch <= 'z' THEN
  447.             code = code - 32
  448.  
  449.         IF fontdata.space.code = 'undef' THEN
  450.             code = 32
  451.     END
  452.  
  453.     RETURN code
  454.  
  455.  
  456.  
  457.  
  458. SetupEnv:
  459.     imgw = ARG(1)
  460.     imgd = ARG(2)
  461.  
  462.     GetBrushAttributes 'COLORS'
  463.     cnum = RESULT
  464.     GetBrushAttributes 'HEIGHT'
  465.     imgh = RESULT
  466.  
  467.     Set '"IMAGEW='imgw'" "IMAGEH='imgh'" "COLORS='cnum'" "DISPLAY='imgd'" "SCREENW=-1" "SCREENH='imgh'" "ASCROLL=0"'
  468.  
  469.     RETURN RC
  470.  
  471.  
  472.  
  473.  
  474. SaveSet:
  475.     sname = ARG(1)
  476.     val = ARG(2)
  477.  
  478.     IF OPEN('settingfile', 'ENV:PP_AnimText_'sname, 'W') THEN DO
  479.         CALL WRITECH('settingfile', val)
  480.         CALL CLOSE('settingfile')
  481.     END
  482.  
  483.     RETURN
  484.  
  485.  
  486.  
  487.  
  488. LoadSet:
  489.     sname = ARG(1)
  490.     def_val = ARG(2)
  491.  
  492.     val = def_val
  493.     IF OPEN('settingfile', 'ENV:PP_AnimText_'sname, 'R') THEN DO
  494.         val = READCH('settingfile', 65535)
  495.         CALL CLOSE('settingfile')
  496.     END
  497.  
  498.     /* encode quotes for the Request command ('"' -> '\""') */
  499.     qpos_start = 1
  500.     DO FOREVER
  501.         qpos = INDEX(val, '"', qpos_start)
  502.         IF qpos = 0 THEN BREAK
  503.         val = INSERT('\"', val, qpos-1)
  504.         qpos_start = qpos + 3
  505.     END
  506.  
  507.     RETURN val
  508.